home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-dired.el.z / efs-dired.el
Encoding:
Text File  |  1998-05-21  |  55.6 KB  |  1,636 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-dired.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.32 $
  7. ;; RCS:          
  8. ;; Description:  Extends much of Dired to work under efs.
  9. ;; Authors:      Sebastian Kremer <sk@thp.uni-koeln.de>, 
  10. ;;               Andy Norman <ange@hplb.hpl.hp.com>,
  11. ;;               Sandy Rutherford <sandy@ibm550.sissa.it>
  12. ;; Created:      Throughout the ages.
  13. ;; Language:     Emacs-Lisp
  14. ;;
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. ;;; Provisions and requirements
  18.  
  19. (provide 'efs-dired)
  20. (require 'efs)
  21. (require 'dired)
  22. (autoload 'dired-shell-call-process "dired-shell")
  23.  
  24. (defconst efs-dired-version
  25.   (concat (substring "$efs release: 1.15 $" 14 -2)
  26.       "/"
  27.       (substring "#Revision: 1.32 $" 11 -2)))
  28.  
  29. ;;;; ----------------------------------------------------------------
  30. ;;;; User Configuration Variables
  31. ;;;; ----------------------------------------------------------------
  32.  
  33. (defvar efs-dired-verify-modtime-host-regexp nil
  34.   "Regular expression determining on which hosts dired modtimes are checked.")
  35.  
  36. (defvar efs-dired-verify-anonymous-modtime nil
  37.   "If non-nil, dired modtimes are checked for anonymous logins.")
  38.  
  39. ;;; Internal Variables
  40.  
  41. (make-variable-buffer-local 'dired-ls-F-marks-symlinks)
  42.  
  43. ;;;; -----------------------------------------------------------
  44. ;;;; Inserting Directories into Buffers
  45. ;;;; -----------------------------------------------------------
  46.  
  47. ;; The main command for inserting a directory listing in a buffer.
  48. ;; In Emacs 19 this is in files.el, and not specifically connected to
  49. ;; dired. Since our version of it uses some dired functions, it is
  50. ;; included here, but there is an autoload for it in efs.el.
  51.  
  52. (defun efs-insert-directory (file switches &optional wildcard full-directory-p
  53.                   nowait marker-char)
  54.   ;; Inserts a remote directory. Can do this asynch.
  55.   (let* ((parsed (efs-ftp-path file))
  56.      (mk (point-marker))
  57.      (host (car parsed))
  58.      (user (nth 1 parsed))
  59.      (path (nth 2 parsed))
  60.      (host-type (efs-host-type host))
  61.      (dumb (memq host-type efs-dumb-host-types))
  62.      (subdir (and (null (or full-directory-p wildcard))
  63.               (condition-case nil
  64.               (dired-current-directory)
  65.             (error nil))))
  66.      (case-fold-search nil) ; for testing switches
  67.      (parse (and full-directory-p (not wildcard)
  68.              (or dumb (efs-parsable-switches-p switches))))
  69.      ;; In case dired-omit-silent isn't defined.
  70.      (dired-omit-silent (and (boundp 'dired-omit-silent)
  71.                  dired-omit-silent)))
  72.     
  73.     ;; Insert the listing. If it's not a wild-card, and not a full-dir,
  74.     ;; then we are updating a dired-line. Do this asynch.
  75.     ;; This way of doing the listing makes sure that the dired
  76.     ;; buffer is still around after the listing is obtained.
  77.     
  78.     (efs-ls
  79.      file switches t (if parse 'parse t) nil
  80.      ;; asynch, if we're inserting in a subdir. Do it nowait = 0, so
  81.      ;; updating the file line gets a high priority??
  82.      ;; Insert subdir listings NOWAIT = 0 also so 1-line
  83.      ;; updates don't toggle the mode line.
  84.      (if (and subdir nowait) 0 nowait)
  85.      (efs-cont (listing) (host user file path wildcard
  86.                    nowait marker-char
  87.                    mk subdir parse switches dired-omit-silent)
  88.        ;; We pass the value of dired-omit-silent from the caller to the cont.
  89.        (let ((host-type (efs-host-type host))
  90.          (listing-type (efs-listing-type host user)))
  91.      (if (marker-buffer mk)
  92.          (efs-save-buffer-excursion
  93.            (set-buffer (marker-buffer mk))
  94.            ;; parsing a listing, sometimes updates info
  95.            (if (and parse (eq major-mode 'dired-mode))
  96.            (progn
  97.              (setq efs-dired-host-type host-type
  98.                efs-dired-listing-type listing-type
  99.                efs-dired-listing-type-string
  100.                (and efs-show-host-type-in-dired
  101.                 (concat " "
  102.                     (symbol-name
  103.                      efs-dired-listing-type))))
  104.              (if (memq host-type '(bsd-unix next-unix))
  105.              (setq dired-ls-F-marks-symlinks nil)
  106.                (if (memq host-type '(sysV-unix apollo-unix))
  107.                (setq dired-ls-F-marks-symlinks t)))))
  108.            (if subdir
  109.            ;; a 1-line re-list
  110.            (save-excursion
  111.              (efs-update-file-info
  112.               host-type file efs-data-buffer-name)
  113.              (goto-char mk)
  114.              (let ((new-subdir (condition-case nil
  115.                        (dired-current-directory)
  116.                      (error nil)))
  117.                buffer-read-only)
  118.                (if (and new-subdir
  119.                 (string-equal subdir new-subdir))
  120.                (progn
  121.                  ;; Is there an existing entry?
  122.                  (if (dired-goto-file file)
  123.                  (progn
  124.                    (delete-region
  125.                     (save-excursion
  126.                       (skip-chars-backward "^\n\r")
  127.                       (1- (point)))
  128.                     (progn
  129.                       (skip-chars-forward "^\n\r")
  130.                       (point)))
  131.                    (goto-char mk)))
  132.                  (insert listing)
  133.                  (save-restriction
  134.                    (narrow-to-region mk (point))
  135.                    (efs-dired-fixup-listing
  136.                 listing-type file path switches wildcard)
  137.                    (efs-dired-ls-trim
  138.                 listing-type)
  139.                    ;; save-excursion loses if fixup had to
  140.                    ;; remove and re-add the region. Say for
  141.                    ;; sorting.
  142.                    (goto-char (point-max)))
  143.                  (if (and nowait (eq major-mode 'dired-mode))
  144.                  (dired-after-add-entry
  145.                   (marker-position mk)
  146.                   marker-char))))))
  147.          (goto-char mk)
  148.          (let (buffer-read-only)
  149.            (insert listing)
  150.            (save-restriction
  151.              (narrow-to-region mk (point))
  152.              (efs-dired-fixup-listing
  153.               listing-type file path switches wildcard)
  154.              (goto-char (point-max))))))))))
  155.      ;; Return 0 if synch, nil if asynch
  156.     (if nowait nil 0)))
  157.  
  158. ;;; Functions for cleaning listings.
  159.  
  160. (efs-defun efs-dired-ls-trim nil ()
  161.   ;; Trims dir listings, so that the listing of a single file is one line.
  162.   nil)
  163.  
  164. (efs-defun efs-dired-fixup-listing nil (file path &optional switches wildcard)
  165.   ;; FILE is in efs syntax.
  166.   ;; PATH is just the remote path.
  167.   ;; Some ftpd's put the whole directory name in front of each filename.
  168.   ;; Seems to depend in a strange way on server-client interaction.
  169.   ;; Walk down the listing generated and remove this stuff.
  170.   ;; SWITCHES is a string.
  171.   (if (memq efs-key efs-unix-host-types)
  172.       (let ((continue t)
  173.         spot bol)
  174.     (goto-char (point-min))
  175.     (while (and (not (eobp)) continue)
  176.       (and (setq bol (point)
  177.              spot (dired-manual-move-to-filename nil bol))
  178.            (setq continue (= (following-char) ?/))
  179.            (dired-manual-move-to-end-of-filename t bol)
  180.            (progn
  181.          (skip-chars-backward "^/")
  182.          (delete-region spot (point))))
  183.       (forward-line 1))
  184.     (efs-save-match-data
  185.       (if (and switches (string-match "R" switches)
  186.            (not (string-match "d" switches)))
  187.           (let ((subdir-regexp "^\\(/[^ \n\r]+\\):[\n\r]")
  188.             name)
  189.         (goto-char (point-min))
  190.         (while (re-search-forward subdir-regexp nil t)
  191.           (goto-char (match-beginning 0))
  192.           ;; There may be /./ type nonsense.
  193.           ;; expand-file-name will handle it.
  194.           (setq name (expand-file-name
  195.                   (buffer-substring (point) (match-end 0))))
  196.           (delete-region (point) (match-end 0))
  197.           (insert (efs-replace-path-component file name)))))))))
  198.  
  199.  
  200. ;;;; ------------------------------------------------------------
  201. ;;;; Tree Dired support
  202. ;;;; ------------------------------------------------------------
  203.  
  204. ;;; efs-dired keymap
  205.  
  206. (defvar efs-dired-map nil
  207.   "Keymap for efs commands in dired buffers.")
  208.  
  209. (if efs-dired-map
  210.     ()
  211.   (setq efs-dired-map (make-sparse-keymap))
  212.   (define-key efs-dired-map "c" 'efs-dired-close-ftp-process)
  213.   (define-key efs-dired-map "k" 'efs-dired-kill-ftp-process)
  214.   (define-key efs-dired-map "o" 'efs-dired-display-ftp-process-buffer)
  215.   (define-key efs-dired-map "p" 'efs-dired-ping-connection))
  216.  
  217. (fset 'efs-dired-prefix efs-dired-map)
  218.  
  219. ;;; Functions for dealing with the FTP process
  220.  
  221. (defun efs-dired-close-ftp-process ()
  222.   "Close the FTP process for the current dired buffer.
  223. Closing causes the connection to be dropped, but efs will retain its
  224. cached data for the connection.  This will make it more efficient to
  225. reopen the connection."
  226.   (interactive)
  227.   (or efs-dired-host-type
  228.       (error "Dired buffer is not for a remote directory."))
  229.   (efs-close-ftp-process (current-buffer))
  230.   (let ((parsed (efs-ftp-path default-directory)))
  231.     (message "Closed FTP connection for %s@%s." (nth 1 parsed) (car parsed))))
  232.  
  233. (defun efs-dired-kill-ftp-process ()
  234.   "Kills the FTP process for the current dired buffer.
  235. Killing causes the connection to be closed, the process buffer to be killed,
  236. and most of efs's cached data to be wiped."
  237.   (interactive)
  238.   (or efs-dired-host-type
  239.       (error "Dired buffer is not for a remote directory."))
  240.   (efs-kill-ftp-process (current-buffer))
  241.   (let ((parsed (efs-ftp-path default-directory)))
  242.     (message "Killed FTP connection for %s@%s." (nth 1 parsed) (car parsed))))
  243.  
  244. (defun efs-dired-display-ftp-process-buffer ()
  245.   "Displays in another window the FTP process buffer for a dired buffer."
  246.   (interactive)
  247.   (or efs-dired-host-type
  248.       (error "Dired buffer is not for a remote directory."))
  249.   (efs-display-ftp-process-buffer (current-buffer)))
  250.  
  251. (defun efs-dired-ping-connection ()
  252.   "Pings FTP connection associated with current dired buffer."
  253.   (interactive)
  254.   (or efs-dired-host-type
  255.       (error "Dired buffer is not for a remote directory."))
  256.   (efs-ping-ftp-connection (current-buffer)))
  257.  
  258.  
  259. ;;; Reading in dired buffers.
  260.  
  261. (defun efs-dired-revert (&optional arg noconfirm)
  262.   (let ((efs-ls-uncache t))
  263.     (dired-revert arg noconfirm)))
  264.  
  265. (defun efs-dired-default-dir-function ()
  266.   (let* ((cd (dired-current-directory))
  267.      (parsed (efs-ftp-path cd)))
  268.     (if parsed
  269.     (efs-save-match-data
  270.       (let ((tail directory-abbrev-alist))
  271.         (while tail
  272.           (if (string-match (car (car tail)) cd)
  273.           (setq cd (concat (cdr (car tail))
  274.                    (substring cd (match-end 0)))
  275.             parsed nil))
  276.           (setq tail (cdr tail)))
  277.         (apply 'efs-unexpand-parsed-filename
  278.            (or parsed (efs-ftp-path cd)))))
  279.       cd)))
  280.  
  281. (defun efs-dired-before-readin ()
  282.   ;; Put in the dired-before-readin-hook.
  283.   (let ((parsed (efs-ftp-path default-directory)))
  284.     (if parsed
  285.     (let ((host (car parsed))
  286.           (user (nth 1 parsed)))
  287.       (setq efs-dired-listing-type (efs-listing-type host user)
  288.         efs-dired-host-type (efs-host-type host)
  289.         efs-dired-listing-type-string
  290.         (and efs-show-host-type-in-dired
  291.              (concat " " (symbol-name efs-dired-listing-type))))
  292.       (set (make-local-variable 'revert-buffer-function)
  293.            (function efs-dired-revert))
  294.       (set (make-local-variable 'default-directory-function)
  295.            (function efs-dired-default-dir-function))
  296.       (set (make-local-variable 'dired-verify-modtimes)
  297.            (null (null (and
  298.                 efs-dired-verify-modtime-host-regexp
  299.                 (efs-save-match-data
  300.                   (let ((case-fold-search t))
  301.                 (string-match
  302.                  efs-dired-verify-modtime-host-regexp host))
  303.                   (or efs-dired-verify-anonymous-modtime
  304.                       (not (efs-anonymous-p user))))))))
  305.       ;; The hellsoft ftp server mixes up cases.
  306.       ;; However, we may not be able to catch this until
  307.       ;; after the first directory is listed. 
  308.       (if (and
  309.            (eq efs-dired-host-type 'hell)
  310.            (not (string-equal default-directory
  311.                   (setq default-directory
  312.                     (downcase default-directory)))))
  313.           (or (string-equal (buffer-name) (downcase (buffer-name)))
  314.           (rename-buffer (generate-new-buffer-name
  315.                   (directory-file-name default-directory)))))
  316.       ;; Setup the executable and directory regexps
  317.       (let ((eentry (assq efs-dired-listing-type
  318.                   efs-dired-re-exe-alist))
  319.         (dentry (assq efs-dired-listing-type
  320.                   efs-dired-re-dir-alist)))
  321.         (if eentry
  322.         (set (make-local-variable 'dired-re-exe) (cdr eentry)))
  323.         (if dentry
  324.         (set (make-local-variable 'dired-re-dir) (cdr dentry))))
  325.       ;; No switches are sent to dumb hosts, so don't confuse dired.
  326.       ;; I hope that dired doesn't get excited if it doesn't see the l
  327.       ;; switch. If it does, then maybe fake things by setting this to
  328.       ;; "-Al".
  329.       (if (eq efs-dired-listing-type 'vms)
  330.           (setq dired-internal-switches
  331.             (delq ?F dired-internal-switches))
  332.         (if (memq efs-dired-host-type efs-dumb-host-types)
  333.         (setq dired-internal-switches '(?l ?A)
  334.               ;; Don't lie on the mode line
  335.               dired-sort-mode "")))
  336.       ;; If the remote file system is version-based, don't set
  337.       ;; dired-kept-versions to 0. It will flag the most recent
  338.       ;; copy of the file for deletion -- this isn't really a backup.
  339.       (if (memq efs-dired-host-type efs-version-host-types)
  340.           (set (make-local-variable 'dired-kept-versions)
  341.            (max 1 dired-kept-versions)))))))
  342.  
  343. (efs-defun efs-dired-insert-headerline (&use efs-dired-listing-type) (dir)
  344.   "Documented as original."
  345.   (efs-real-dired-insert-headerline dir))
  346.  
  347. (defun efs-dired-uncache (file dir-p)
  348.   ;; Remove FILE from cache.
  349.   (if dir-p
  350.       (efs-del-from-ls-cache file nil t)
  351.     (efs-del-from-ls-cache file t nil)))
  352.  
  353. ;;; Checking modtimes of directories.
  354. ;;
  355. ;;  This only runs if efs-dired-verify-anonymous-modtime and
  356. ;;  efs-verify-modtime-host-regexp turn it on.  Few (any?) FTP servers
  357. ;;  support getting MDTM for directories.  As usual, we cache whether
  358. ;;  this works, and don't keep senselessly trying it if it doesn't.
  359.  
  360. (defun efs-dired-file-modtime (file)
  361.   ;; Returns the modtime.
  362.   (let* ((parsed (efs-ftp-path file))
  363.      (host (car parsed))
  364.      (user (nth 1 parsed))
  365.      (rpath (nth 2 parsed)))
  366.     (and (null (efs-get-host-property host 'dir-mdtm-failed))
  367.      (let ((result (efs-send-cmd host user (list 'quote 'mdtm rpath)
  368.                      (and (eq efs-verbose t)
  369.                       "Getting modtime")))
  370.            mp)
  371.        (if (and (null (car result))
  372.             (setq mp (efs-parse-mdtime (nth 1 result))))
  373.            (let ((ent (efs-get-file-entry file)))
  374.          (if ent
  375.              (setcdr ent (list (nth 1 ent) (nth 2 ent)
  376.                        (nth 3 ent) (nth 4 ent) mp)))
  377.          parsed)
  378.          (efs-set-host-property host 'dir-mdtm-failed t)
  379.          nil)))))
  380.  
  381. (defun efs-dired-set-file-modtime (file alist)
  382.   ;; This works asynch.
  383.   (let* ((parsed (efs-ftp-path file))
  384.      (host (car parsed))
  385.      (user (nth 1 parsed))
  386.      (path (nth 2 parsed)))
  387.     (if (efs-get-host-property host 'dir-mdtm-failed)
  388.     (let ((elt (assoc file alist)))
  389.       (if elt (setcar (nthcdr 4 elt) nil)))
  390.       (efs-send-cmd
  391.        host user (list 'quote 'mdtm path) nil nil
  392.        (efs-cont (result line cont-lines) (file alist host)
  393.      (let ((elt (assoc file alist))
  394.            modtime)
  395.        (if (and (null result) (setq modtime (efs-parse-mdtime line)))
  396.            (if elt (setcar (nthcdr 4 elt) modtime))
  397.          (if elt (setcar (nthcdr 4 elt) nil))
  398.          (efs-set-host-property host 'dir-mdtm-failed t))))
  399.        0)    ; Always do this NOWAIT = 0
  400.       nil))) ; return NIL
  401.  
  402. ;;; Asynch insertion of subdirs.  Used when renaming subdirs.
  403.  
  404. (defun efs-dired-insert-subdir (dirname &optional noerror nowait)
  405.   (let ((buff (current-buffer))
  406.     (switches (delq ?R (copy-sequence dired-internal-switches))))
  407.     (efs-ls
  408.      dirname (dired-make-switches-string switches)
  409.      t nil noerror nowait
  410.      (efs-cont (listing) (dirname buff switches)
  411.        (if (and listing (get-buffer buff))
  412.        (save-excursion
  413.          (set-buffer buff)
  414.          (save-excursion
  415.            (let ((elt (assoc dirname dired-subdir-alist))
  416.              mark-list)
  417.          (if elt
  418.              (setq mark-list (dired-insert-subdir-del elt))
  419.            (dired-insert-subdir-newpos dirname))
  420.          (dired-insert-subdir-doupdate
  421.           dirname
  422.           (efs-dired-insert-subdir-do-insert dirname listing)
  423.           switches elt mark-list)))))))))
  424.  
  425. (defun efs-dired-insert-subdir-do-insert (dirname listing)
  426.   (let ((begin (point))
  427.     indent-tabs-mode end)
  428.     (insert listing)
  429.     (setq end (point-marker))
  430.     (indent-rigidly begin end 2)
  431.     (goto-char begin)
  432.     (dired-insert-headerline dirname)
  433.     ;; If the listing has null lines `quote' them so that "\n\n" delimits
  434.     ;; subdirs.  This is OK, because we aren't inserting -R listings.
  435.     (save-excursion
  436.       (while (search-forward "\n\n" end t)
  437.     (forward-char -1)
  438.     (insert " ")))
  439.     ;; point is now like in dired-build-subdir-alist
  440.     (prog1
  441.     (list begin (marker-position end))
  442.       (set-marker end nil))))
  443.  
  444. ;;; Moving around in dired buffers.
  445.  
  446. (efs-defun efs-dired-manual-move-to-filename (&use efs-dired-listing-type)
  447.   (&optional raise-error bol eol)
  448.   "Documented as original."
  449.   (efs-real-dired-manual-move-to-filename raise-error bol eol))
  450.  
  451. (efs-defun efs-dired-manual-move-to-end-of-filename
  452.   (&use efs-dired-listing-type) (&optional no-error bol eol)
  453.   "Documented as original."
  454.   (efs-real-dired-manual-move-to-end-of-filename no-error bol eol))
  455.  
  456. (efs-defun efs-dired-make-filename-string (&use efs-dired-listing-type)
  457.   (filename &optional reverse)
  458.   "Documented as original."
  459.   ;; This translates file names from the way that they are displayed
  460.   ;; in listings to the way that the user gives them in the minibuffer.
  461.   ;; For example, in CMS this should take "FOO BAR" to "FOO.BAR".
  462.   filename)
  463.  
  464. (defun efs-dired-find-file ()
  465.   "Documented as original."
  466.   (interactive)
  467.   (find-file
  468.    (if (memq efs-dired-host-type efs-version-host-types)
  469.        (efs-internal-file-name-sans-versions
  470.     efs-dired-host-type (dired-get-filename) t)
  471.      (dired-get-filename))))
  472.  
  473. (defun efs-dired-find-file-other-window (&optional display)
  474.   "Documented as original."
  475.   (interactive "P")
  476.   (if display
  477.       (dired-display-file)
  478.     (let ((file (dired-get-filename)))
  479.       (if (memq efs-dired-host-type efs-version-host-types)
  480.       (setq file (efs-internal-file-name-sans-versions
  481.               efs-dired-host-type file t)))
  482.       (find-file-other-window file))))
  483.  
  484. (defun efs-dired-display-file ()
  485.   "Documented as original."
  486.   (interactive)
  487.   (let ((file (dired-get-filename)))
  488.     (if (memq efs-dired-host-type efs-version-host-types)
  489.     (setq file (efs-internal-file-name-sans-versions
  490.             efs-dired-host-type file t)))
  491.     (display-buffer (find-file-noselect file))))
  492.  
  493. (defun efs-dired-find-file-other-frame ()
  494.   "Documented as original."
  495.   (interactive)
  496.   (find-file-other-frame
  497.    (if (memq efs-dired-host-type efs-version-host-types)
  498.        (efs-internal-file-name-sans-versions
  499.     efs-dired-host-type (dired-get-filename) t)
  500.      (dired-get-filename))))
  501.  
  502. ;;; Creating and deleting new directories.
  503.  
  504. (defun efs-dired-recursive-delete-directory (fn)
  505.   ;; Does recursive deletion of remote directories for dired.
  506.   (or (file-exists-p fn)
  507.       (signal 'file-error
  508.           (list "Removing old file name" "no such directory" fn)))
  509.   (efs-dired-internal-recursive-delete-directory fn))
  510.  
  511. (defun efs-dired-internal-recursive-delete-directory (fn)
  512.   (if (eq (car (file-attributes fn)) t)
  513.       (let ((files (efs-directory-files fn)))
  514.     (if files
  515.         (mapcar (function
  516.              (lambda (ent)
  517.                (or (string-equal "." ent)
  518.                (string-equal ".." ent)
  519.                (efs-dired-internal-recursive-delete-directory
  520.                 (expand-file-name ent fn)))))
  521.             files))
  522.     (efs-delete-directory fn))
  523.     (condition-case err
  524.     (efs-delete-file fn)
  525.       (ftp-error (if (and (nth 2 err) (stringp (nth 2 err))
  526.               (efs-save-match-data
  527.                 (string-match "^FTP Error: \"550 " (nth 2 err))))
  528.              (message "File %s already deleted." fn)
  529.            (signal (car err) (cdr err)))))))
  530.  
  531. ;;; File backups and versions.
  532.  
  533. (efs-defun efs-dired-flag-backup-files
  534.   (&use efs-dired-host-type) (&optional unflag-p)
  535.   "Documented as original."
  536.   (interactive "P")
  537.   (efs-real-dired-flag-backup-files unflag-p))
  538.  
  539. (efs-defun efs-dired-collect-file-versions (&use efs-dired-host-type) ()
  540.   ;; If it looks like a file has versions, return a list of the versions.
  541.   ;; The return value is ((FILENAME . (VERSION1 VERSION2 ...)) ...)
  542.   (efs-real-dired-collect-file-versions))
  543.  
  544. ;;; Sorting dired buffers
  545.  
  546. (defun efs-dired-file-name-lessp (name1 name2)
  547.   (if (and efs-dired-host-type
  548.        (memq efs-dired-host-type efs-case-insensitive-host-types))
  549.       (string< (downcase name1) (downcase name2))
  550.     (string< name1 name2)))
  551.  
  552. ;;; Support for async file creators.
  553.  
  554. (defun efs-dired-copy-file (from to ok-flag &optional cont nowait)
  555.   ;; Version of dired-copy-file for remote files.
  556.   ;; Assumes that filenames are already expanded.
  557.   (dired-handle-overwrite to)
  558.   (efs-copy-file-internal from (efs-ftp-path from) to (efs-ftp-path to)
  559.               ok-flag dired-copy-preserve-time 0 cont nowait))
  560.  
  561. (defun efs-dired-rename-file (from to ok-flag &optional cont nowait
  562.                    insert-subdir)
  563.   ;; Version of dired-rename-file for remote files.
  564.   (dired-handle-overwrite to)
  565.   (efs-rename-file-internal
  566.    from to ok-flag nil
  567.    (efs-cont (result line cont-lines) (from to cont insert-subdir)
  568.      (if result
  569.      (if cont
  570.          (efs-call-cont cont result line cont-lines)
  571.        (signal 'ftp-error
  572.            (list "Dired Renaming"
  573.              (format "FTP Error: \"%s\"" line)
  574.              from to)))
  575.        (dired-remove-file from)
  576.        ;; Silently rename the visited file of any buffer visiting this file.
  577.        ;; We do not maintain inserted subdirs for remote 
  578.        (efs-dired-rename-update-buffers from to insert-subdir)
  579.        (if cont (efs-call-cont cont result line cont-lines))))
  580.    nowait))
  581.  
  582. (defun efs-dired-rename-update-buffers (from to &optional insert-subdir)
  583.   (if (get-file-buffer from)
  584.       (save-excursion
  585.     (set-buffer (get-file-buffer from))
  586.     (let ((modflag (buffer-modified-p)))
  587.       (set-visited-file-name to)    ; kills write-file-hooks
  588.       (set-buffer-modified-p modflag)))
  589.     ;; It's a directory.  More work to do.
  590.     (let ((blist (buffer-list))
  591.       (from-dir (file-name-as-directory from))
  592.       (to-dir (file-name-as-directory to)))
  593.       (save-excursion
  594.     (while blist
  595.       (set-buffer (car blist))
  596.       (setq blist (cdr blist))
  597.       (cond
  598.        (buffer-file-name
  599.         (if (dired-in-this-tree buffer-file-name from-dir)
  600.         (let ((modflag (buffer-modified-p)))
  601.           (unwind-protect
  602.               (set-visited-file-name
  603.                (concat to-dir (substring buffer-file-name
  604.                          (length from-dir))))
  605.             (set-buffer-modified-p modflag)))))
  606.        (dired-directory
  607.         (if (string-equal from-dir (expand-file-name default-directory))
  608.         ;; If top level directory was renamed, lots of things
  609.         ;; have to be updated.
  610.         (progn
  611.           (dired-unadvertise from-dir)
  612.           (setq default-directory to-dir
  613.             dired-directory
  614.             ;; Need to beware of wildcards.
  615.             (expand-file-name 
  616.              (file-name-nondirectory dired-directory)
  617.              to-dir))
  618.           (let ((new-name (file-name-nondirectory
  619.                    (directory-file-name dired-directory))))
  620.             ;; Try to rename buffer, but just leave old name if new
  621.             ;; name would already exist (don't try appending "<%d>")
  622.             ;; Why?  --sandy 19-8-94
  623.             (or (get-buffer new-name)
  624.             (rename-buffer new-name)))
  625.           (dired-advertise))
  626.           (and insert-subdir
  627.            (assoc (file-name-directory (directory-file-name to))
  628.               dired-subdir-alist)
  629.            (if (efs-ftp-path to)
  630.                (efs-dired-insert-subdir to t 1)
  631.              (dired-insert-subdir to)))))))))))
  632.  
  633. (defun efs-dired-make-relative-symlink (from to ok-flag &optional cont nowait)
  634.   ;; efs version of dired-make-relative-symlink
  635.   ;; Called as a file-name-handler when dired-make-relative-symlink is
  636.   ;; called interactively.
  637.   ;; efs-dired-create-files calls it directly to supply CONT
  638.   ;; and NOWAIT args.
  639.   (setq from (directory-file-name from)
  640.     to (directory-file-name to))
  641.   (efs-make-symbolic-link-internal
  642.    (dired-make-relative from (file-name-directory to) t)
  643.    to ok-flag cont nowait))
  644.  
  645. (defun efs-dired-create-files (file-creator operation fn-list name-constructor
  646.                         &optional marker-char query
  647.                         implicit-to)
  648.   "Documented as original."
  649.   (if (catch 'found
  650.     (let ((list fn-list)
  651.           val)
  652.       (while list
  653.         (if (setq val (efs-ftp-path (car list)))
  654.         (throw 'found val)
  655.           (if (setq val (funcall name-constructor (car list)))
  656.           (throw 'found (efs-ftp-path val))
  657.         (setq list (cdr list)))))))
  658.       (progn
  659.     (cond ((eq file-creator 'dired-copy-file)
  660.            (setq file-creator 'efs-dired-copy-file))
  661.           ((eq file-creator 'dired-rename-file)
  662.            (setq file-creator 'efs-dired-rename-file))
  663.           ((eq file-creator 'make-symbolic-link)
  664.            (setq file-creator 'efs-make-symbolic-link-internal))
  665.           ((eq file-creator 'add-name-to-file)
  666.            (setq file-creator 'efs-add-name-to-file-internal))
  667.           ((eq file-creator 'dired-make-relative-symlink)
  668.            (setq file-creator 'efs-dired-make-relative-symlink))
  669.           ((eq file-creator 'dired-compress-file)
  670.            (setq file-creator 'efs-dired-compress-file))
  671.           ((error "Unable to perform operation %s on remote hosts."
  672.               file-creator)))
  673.     ;; use the process-filter driven routine rather than the iterative one.
  674.     (efs-dcf-1 file-creator operation fn-list name-constructor
  675.            (if (eq marker-char t)
  676.                (mapcar 'dired-file-marker fn-list)
  677.              marker-char)
  678.            query (buffer-name (current-buffer))
  679.            nil    ;overwrite-query
  680.            nil    ;dired-overwrite-backup-query
  681.            nil  ;dired-file-creator-query
  682.            nil    ;failures
  683.            nil    ;skipped
  684.            0        ;success-count
  685.            (length fn-list) ;total
  686.            implicit-to
  687.            (and (eq file-creator 'efs-dired-rename-file)
  688.             (delq nil
  689.                   (mapcar
  690.                    (function
  691.                 (lambda (x)
  692.                   (and (assoc (file-name-as-directory x)
  693.                           dired-subdir-alist)
  694.                        x)))
  695.                    fn-list)))))
  696.     ;; normal case... use the interative routine... much cheaper.
  697.     (efs-real-dired-create-files file-creator operation fn-list
  698.                  name-constructor marker-char query
  699.                  implicit-to)))
  700.  
  701. (defun efs-dcf-1 (file-creator operation fn-list name-constructor
  702.                    markers query buffer-name overwrite-query 
  703.                    overwrite-backup-query file-creator-query
  704.                    failures skipped success-count total
  705.                    implicit-to insertions)
  706.   (if (null fn-list)
  707.       (efs-dcf-3 failures operation total skipped
  708.          success-count buffer-name)
  709.     (let* ((from (car fn-list))
  710.        ;; For dired-handle-overwrite and the file-creator-query,
  711.        ;; need to set these 2 fluid vars according to the cont data.
  712.        (dired-overwrite-backup-query overwrite-backup-query)
  713.        (dired-file-creator-query file-creator-query)
  714.        (to (funcall name-constructor from))
  715.        (marker-char (if (consp markers)
  716.                 (prog1 (car markers)
  717.                   (setq markers (cdr markers)))
  718.               markers))
  719.        (fn-list (cdr fn-list)))
  720.       (if to
  721.       (if (equal to from)
  722.           (progn
  723.         (dired-log buffer-name "Cannot %s to same file: %s\n"
  724.                (downcase operation) from)
  725.         (efs-dcf-1 file-creator operation fn-list name-constructor
  726.                markers query buffer-name overwrite-query
  727.                dired-overwrite-backup-query
  728.                dired-file-creator-query failures
  729.                (cons (dired-make-relative from nil t) skipped)
  730.                success-count total implicit-to insertions))
  731.         (if (or (null query)
  732.             (funcall query from to))
  733.         (let* ((overwrite (let (jka-compr-enabled)
  734.                     ;; Don't let jka-compr fool us.
  735.                     (file-exists-p to)))
  736.                (overwrite-confirmed ; for dired-handle-overwrite
  737.             (and overwrite
  738.                  (let ((help-form '(format "\
  739. Type SPC or `y' to overwrite file `%s',
  740. DEL or `n' to skip to next,
  741. ESC or `q' to not overwrite any of the remaining files,
  742. `!' to overwrite all remaining files with no more questions." to)))
  743.                    (dired-query 'overwrite-query
  744.                         "Overwrite `%s'?" to)))))
  745.           (condition-case err
  746.               (let ((dired-unhandle-add-files
  747.                  (cons to dired-unhandle-add-files)))
  748.             (if implicit-to
  749.                 (funcall file-creator from overwrite-confirmed
  750.                      (list (function efs-dcf-2)
  751.                        file-creator operation fn-list
  752.                        name-constructor markers
  753.                        query marker-char
  754.                        buffer-name to from overwrite
  755.                        overwrite-confirmed overwrite-query 
  756.                        dired-overwrite-backup-query
  757.                        dired-file-creator-query
  758.                        failures skipped success-count
  759.                        total implicit-to insertions)
  760.                      t)
  761.               (apply file-creator from to overwrite-confirmed
  762.                  (list (function efs-dcf-2)
  763.                        file-creator operation fn-list
  764.                        name-constructor markers
  765.                        query marker-char
  766.                        buffer-name to from overwrite
  767.                        overwrite-confirmed overwrite-query 
  768.                        dired-overwrite-backup-query
  769.                        dired-file-creator-query
  770.                        failures skipped success-count total
  771.                        implicit-to insertions)
  772.                  (if insertions
  773.                      (list t insertions)
  774.                    '(t)))))
  775.             (error              ; FILE-CREATOR aborted
  776.              (efs-dcf-2 'failed ;result
  777.                 (format "%s" err) ;line
  778.                 "" file-creator operation fn-list
  779.                 name-constructor markers query marker-char
  780.                 buffer-name to from overwrite
  781.                 overwrite-confirmed overwrite-query
  782.                 dired-overwrite-backup-query
  783.                 dired-file-creator-query failures skipped
  784.                 success-count total implicit-to insertions))))
  785.           (efs-dcf-1 file-creator operation fn-list name-constructor
  786.              markers query buffer-name overwrite-query
  787.              dired-overwrite-backup-query dired-file-creator-query
  788.              failures
  789.              (cons (dired-make-relative from nil t) skipped)
  790.              success-count total implicit-to insertions)))
  791.     (efs-dcf-1 file-creator operation fn-list name-constructor
  792.            markers query buffer-name overwrite-query
  793.            dired-overwrite-backup-query dired-file-creator-query
  794.            failures (cons (dired-make-relative from nil t) skipped)
  795.            success-count total implicit-to insertions)))))
  796.  
  797. (defun efs-dcf-2 (result line cont-lines file-creator operation fn-list
  798.              name-constructor markers query marker-char
  799.              buffer-name to from overwrite overwrite-confirmed
  800.              overwrite-query overwrite-backup-query
  801.              file-creator-query failures skipped success-count
  802.              total implicit-to insertions)
  803.   (if result
  804.       (progn
  805.     (setq failures (cons (dired-make-relative from nil t) failures))
  806.     (dired-log buffer-name "%s `%s' to `%s' failed:\n%s\n"
  807.            operation from to line))
  808.     (setq success-count (1+ success-count))
  809.     (message "%s: %d of %d" operation success-count total)
  810.     (let ((efs-ls-uncache t))
  811.       (dired-add-file to marker-char)))
  812.   ;; iterate again
  813.   (efs-dcf-1 file-creator operation fn-list name-constructor
  814.          markers query buffer-name overwrite-query overwrite-backup-query
  815.          file-creator-query failures skipped success-count total
  816.          implicit-to insertions))
  817.  
  818. (defun efs-dcf-3 (failures operation total skipped success-count buffer-name)
  819.   (cond
  820.    (failures
  821.     (dired-log-summary buffer-name (format "%s failed for %d of %d file%s"
  822.                        operation (length failures) total
  823.                        (dired-plural-s total)) failures))
  824.    (skipped
  825.     (dired-log-summary buffer-name (format "%s: %d of %d file%s skipped"
  826.                        operation (length skipped) total
  827.                        (dired-plural-s total)) skipped))
  828.    (t
  829.     (message "%s: %s file%s."
  830.          operation success-count
  831.          (dired-plural-s success-count)))))
  832.  
  833. ;;; Running remote shell commands
  834.  
  835. ;;; This support isn't very good. efs is really about a virtual file system,
  836. ;;; and not remote processes. What is really required is low-level
  837. ;;; support for start-process & call-process on remote hosts. This shouldn't
  838. ;;; be part of efs, although.
  839.  
  840. (defun efs-dired-shell-unhandle-file-name (filename)
  841.   ;; Puts remote file names into a form where they can be passed to remsh.
  842.   (nth 2 (efs-ftp-path filename)))
  843.  
  844. (defun efs-dired-shell-call-process (command dir &optional in-background)
  845.   ;; Runs shell process on remote hosts.
  846.   (let* ((parsed (efs-ftp-path dir))
  847.      (host (car parsed))
  848.      (user (nth 1 parsed))
  849.      (rdir (nth 2 parsed))
  850.      (file-name-handler-alist nil))
  851.     (or (string-equal (efs-internal-directory-file-name dir)
  852.               (efs-expand-tilde "~" (efs-host-type host) host user))
  853.     (string-match "^cd " command)
  854.     (setq command (concat "cd " rdir "; " command)))
  855.     (setq command
  856.       (format  "%s %s%s \"%s\""    ; remsh -l USER does not work well
  857.                     ; on a hp-ux machine I tried
  858.            efs-remote-shell-file-name host
  859.            (if efs-remote-shell-takes-user
  860.                (concat " -l " user)
  861.              "")
  862.            command))
  863.     (message "Doing shell command on %s..." host)
  864.     (dired-shell-call-process
  865.      command (file-name-directory efs-tmp-name-template) in-background)))
  866.  
  867. ;;; Dired commands for running local processes on remote files.
  868. ;;
  869. ;;  Lots of things in this section need to be re-thunk.
  870.  
  871. (defun efs-dired-call-process (program discard &rest arguments)
  872.   "Documented as original."
  873.   ;; PROGRAM is always one of those below in the cond in dired.el.
  874.   ;; The ARGUMENTS are (nearly) always files.
  875.   (if (efs-ftp-path default-directory)
  876.       ;; Can't use efs-dired-host-type here because the current
  877.       ;; buffer is *dired-check-process output*
  878.       (condition-case oops
  879.       (cond
  880.        ((string-equal "efs-call-compress" program)
  881.         (apply 'efs-call-compress arguments))
  882.        ((string-equal "chmod" program)
  883.         (efs-call-chmod arguments))
  884.        (t (error "Unknown remote command: %s" program)))
  885.     (ftp-error (dired-log (buffer-name (current-buffer))
  886.                   (format "%s: %s, %s\n"
  887.                       (nth 1 oops)
  888.                       (nth 2 oops)
  889.                       (nth 3 oops))))
  890.     (error (dired-log (buffer-name (current-buffer))
  891.               (format "%s\n" (nth 1 oops)))))
  892.     (apply 'call-process program nil (not discard) nil arguments)))
  893.  
  894. (defun efs-dired-make-compressed-filename (name &optional method)
  895.   ;; Version of dired-make-compressed-filename for efs.
  896.   ;; If NAME is in the syntax of a compressed file (according to
  897.   ;; dired-compression-method-alist), return the data (a list) from this
  898.   ;; alist on how to uncompress it. Otherwise, return a string, the
  899.   ;; uncompressed form of this file name. This is computed using the optional
  900.   ;; argument METHOD (a symbol). If METHOD is nil, the ambient value of
  901.   ;; dired-compression-method is used.
  902.   (let* ((host-type (efs-host-type (car (efs-ftp-path name))))
  903.      (ef-alist (if (memq host-type efs-single-extension-host-types)
  904.                (mapcar
  905.             (function
  906.              (lambda (elt)
  907.                (list (car elt)
  908.                  (mapconcat
  909.                   (function
  910.                    (lambda (char)
  911.                      (if (= char ?.)
  912.                      "-"
  913.                        (char-to-string char))))
  914.                   (nth 1 elt) "")
  915.                  (nth 2 elt)
  916.                  (nth 3 elt))))
  917.             dired-compression-method-alist)
  918.              dired-compression-method-alist))
  919.      (alist ef-alist)
  920.      (len (length name))
  921.      ext ext-len result)
  922.     (if (memq host-type efs-version-host-types)
  923.     (setq name (efs-internal-file-name-sans-versions host-type name)))
  924.     (if (memq host-type efs-case-insensitive-host-types)
  925.     (let ((name (downcase name)))
  926.       (while alist
  927.         (if (and (> len
  928.             (setq ext-len (length (setq ext (nth 1 (car alist))))))
  929.              (string-equal (downcase ext)
  930.                    (substring name (- ext-len))))
  931.         (setq result (car alist)
  932.               alist nil)
  933.           (setq alist (cdr alist)))))
  934.       (while alist
  935.     (if (and (> len
  936.             (setq ext-len (length (setq ext (nth 1 (car alist))))))
  937.          (string-equal ext (substring name (- ext-len))))
  938.         (setq result (car alist)
  939.           alist nil)
  940.       (setq alist (cdr alist)))))
  941.     (or result
  942.     (concat name
  943.         (nth 1 (or (assq (or method dired-compression-method)
  944.                  ef-alist)
  945.                (error "Unknown compression method: %s"
  946.                   (or method dired-compression-method))))))))
  947.  
  948. (defun efs-dired-compress-file (file ok-flag &optional cont nowait)
  949.   ;; Version of dired-compress-file for remote files.
  950.   (let* ((compressed-fn (efs-dired-make-compressed-filename file))
  951.      (host (car (efs-ftp-path file)))
  952.      (host-type (efs-host-type host)))
  953.     (cond ((file-symlink-p file)
  954.        (if cont
  955.            (efs-call-cont
  956.         cont 'failed
  957.         (format "Cannot compress %s, a symbolic link." file) "")
  958.          (signal 'file-error (list "Compress error:" file
  959.                        "a symbolic link"))))
  960.       ((listp compressed-fn)
  961.        (let ((newname (substring (if (memq host-type
  962.                            efs-version-host-types)
  963.                      (efs-internal-file-name-sans-versions
  964.                       host-type file)
  965.                        file)
  966.                       0 (- (length (nth 1 compressed-fn)))))
  967.          (program (nth 3 compressed-fn)))
  968.          (if (and (memq host-type efs-unix-host-types)
  969.               (null (efs-get-host-property host 'exec-failed))
  970.               (null (eq (efs-get-host-property
  971.                  host
  972.                  (intern
  973.                   (concat
  974.                    "exec-"
  975.                    (efs-compress-progname (car program)))))
  976.                 'failed)))
  977.          (efs-call-remote-compress
  978.           program file newname t ok-flag
  979.           (efs-cont (result line cont-lines) (program file newname
  980.                                   cont nowait)
  981.             (if result
  982.             (if (eq result 'unsupported)
  983.                 (efs-call-compress program file newname
  984.                            t t cont nowait)
  985.               (if cont
  986.                   (efs-call-cont cont result line cont-lines)
  987.                 (signal 'ftp-error
  988.                     (list "Uncompressing file"
  989.                       (format "FTP Error: \"%s\" " line)
  990.                       file))))
  991.               (if cont (efs-call-cont cont result line cont-lines))))
  992.           nowait)
  993.            (efs-call-compress
  994.         program file newname t ok-flag cont nowait)
  995.            newname)))
  996.       ((stringp compressed-fn)
  997.        (let ((program (nth 2 (assq dired-compression-method
  998.                        dired-compression-method-alist))))
  999.          (if (and (memq host-type efs-unix-host-types)
  1000.               (null (efs-get-host-property host 'exec-failed))
  1001.               (null (eq (efs-get-host-property
  1002.                  host
  1003.                  (intern
  1004.                   (concat
  1005.                    "exec-"
  1006.                    (efs-compress-progname (car program)))))
  1007.                 'failed)))
  1008.          (efs-call-remote-compress
  1009.           program file compressed-fn nil ok-flag
  1010.           (efs-cont (result line cont-lines) (program file
  1011.                                   compressed-fn
  1012.                                   cont nowait)
  1013.             (if result
  1014.             (if (eq result 'unsupported)
  1015.                 (efs-call-compress program file compressed-fn nil
  1016.                            t cont nowait)
  1017.               (if cont
  1018.                   (efs-call-cont cont result line cont-lines)
  1019.                 (signal 'ftp-error
  1020.                     (list "Compressing file"
  1021.                       (format "FTP Error: \"%s\" " line)
  1022.                       file))))
  1023.               (if cont (efs-call-cont cont result line cont-lines))))
  1024.           nowait)
  1025.            (efs-call-compress
  1026.         program file compressed-fn nil ok-flag cont nowait)))
  1027.        compressed-fn)
  1028.       (t (error "Strange error in efs-dired-compress-file.")))))
  1029.  
  1030. (defun efs-dired-print-file (command file)
  1031.   ;; Version of dired-print-file for remote files.
  1032.   (let ((command (dired-trans-command command (list file) "")))
  1033.     ;; Only replace the first occurence of the file name?
  1034.     (if (string-match (concat "[ ><|]\\(" (regexp-quote
  1035.                        (dired-shell-quote file))
  1036.                   "\\)\\($\\|[ |><&]\\)")
  1037.               command)
  1038.     (setq command (concat (substring command 0 (match-beginning 1))
  1039.                   "%s"
  1040.                   (substring command (match-end 1))))
  1041.       (error "efs-print-command: strange error"))
  1042.   (efs-call-lpr file command)))
  1043.  
  1044. ;;;;----------------------------------------------------------------
  1045. ;;;; Support for `processes' run on remote files.
  1046. ;;;; Usually (but not necessarily) these are only called from dired.
  1047. ;;;;----------------------------------------------------------------
  1048.  
  1049. (defun efs-compress-progname (program)
  1050.   ;; Returns a canonicalized i.e. without the "un", version of a compress
  1051.   ;; program name.
  1052.   (efs-save-match-data
  1053.     (if (string-equal program "gunzip")
  1054.     "gzip"
  1055.       (if (string-match "^un" program)
  1056.       (substring program (match-end 0))
  1057.     program))))
  1058.  
  1059. (defun efs-call-remote-compress (program filename newname &optional uncompress
  1060.                      ok-if-already-exists cont nowait)
  1061.   ;; Run a remote compress process using SITE EXEC.
  1062.   (if (or (not ok-if-already-exists)
  1063.       (numberp ok-if-already-exists))
  1064.       (efs-barf-or-query-if-file-exists
  1065.        newname
  1066.        (if uncompress
  1067.        "uncompress to it"
  1068.      "compress to it")
  1069.        (numberp ok-if-already-exists)))
  1070.   (let* ((filename (expand-file-name filename))
  1071.      (parsed (efs-ftp-path filename))
  1072.      (host (car parsed))
  1073.      (user (nth 1 parsed))
  1074.      (rpath (nth 2 parsed)))
  1075.     (if (efs-get-host-property host 'exec-failed)
  1076.     (if cont
  1077.         (efs-call-cont cont 'unsupported "SITE EXEC not supported" "")
  1078.       (signal 'ftp-error (list "Unable to SITE EXEC" host)))
  1079.       (let* ((progname (efs-compress-progname (car program)))
  1080.          (propsym (intern  (concat "exec-" progname)))
  1081.          (prop (efs-get-host-property host propsym)))
  1082.     (cond
  1083.      ((eq prop 'failed)
  1084.       (if cont
  1085.           (efs-call-cont cont 'unsupported
  1086.                  (concat progname " not in FTP exec path") "")
  1087.         (signal 'ftp-error
  1088.             (list (concat progname " not in FTP exec path") host))))
  1089.      ((eq prop 'worked)
  1090.       (efs-send-cmd
  1091.        host user
  1092.        (list 'quote 'site 'exec
  1093.          (concat (mapconcat 'identity program " ") " " rpath))
  1094.        (concat (if uncompress "Uncompressing " "Compressing ") filename)
  1095.        nil
  1096.        (efs-cont (result line cont-lines) (host user filename cont)
  1097.          (if result
  1098.          (progn
  1099.            (efs-set-host-property host 'exec-failed t)
  1100.            (efs-error host user (concat "FTP exec Error: " line)))
  1101.            (efs-save-match-data
  1102.          (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
  1103.              (let ((err (substring cont-lines (match-beginning 1)
  1104.                        (match-end 1))))
  1105.                (if cont
  1106.                (efs-call-cont cont  'failed err cont-lines)
  1107.              (efs-error host user (concat "FTP Error: " err))))
  1108.            ;; This function only gets called for unix hosts, so
  1109.            ;; we'll use the default version of efs-delete-file-entry
  1110.            ;; and save a host-type lookup.
  1111.            (efs-delete-file-entry nil filename)
  1112.            (dired-remove-file filename)
  1113.            (if cont (efs-call-cont cont nil line cont-lines))))))
  1114.        nowait))
  1115.      (t ; (null prop)
  1116.       (efs-send-cmd
  1117.        host user
  1118.        (list 'quote 'site 'exec (concat progname " " "-V"))
  1119.        (format "Checking for %s executable" progname)
  1120.        nil
  1121.        (efs-cont (result line cont-lines) (propsym host program filename
  1122.                                newname uncompress
  1123.                                cont nowait)
  1124.          (efs-save-match-data
  1125.            (if (string-match "\n200-" cont-lines)
  1126.            (efs-set-host-property host propsym 'worked)
  1127.          (efs-set-host-property host propsym 'failed)))
  1128.          (efs-call-remote-compress program filename newname uncompress
  1129.                        t ; already tested for overwrite
  1130.                        cont nowait))
  1131.        nowait)))))))
  1132.  
  1133. (defun efs-call-compress (program filename newname &optional uncompress
  1134.                   ok-if-already-exists cont nowait)
  1135.   "Perform a compress command on a remote file.
  1136. PROGRAM is a list of the compression program and args. Works by taking a 
  1137. copy of the file, compressing it and copying the file back. Returns 0 on
  1138. success, 1 or 2 on failure. If UNCOMPRESS is non-nil, does this instead."
  1139.   (let* ((filename (expand-file-name filename))
  1140.      (newname (expand-file-name newname))
  1141.      (parsed (efs-ftp-path filename))
  1142.      (tmp1 (car (efs-make-tmp-name nil (car parsed))))
  1143.      (tmp2 (car (efs-make-tmp-name nil (car parsed))))
  1144.      (program (mapconcat 'identity program " ")))
  1145.     (efs-copy-file-internal
  1146.      filename parsed tmp1 nil
  1147.      t nil 2
  1148.      (efs-cont (result line cont-lines) (filename newname tmp1 tmp2 program
  1149.                        uncompress ok-if-already-exists
  1150.                        cont nowait)
  1151.        (if result
  1152.        (signal 'ftp-error
  1153.            (list "Opening input file"
  1154.              (format "FTP Error: \"%s\" " line) filename))
  1155.      (let ((err-buff (let ((default-major-mode 'fundamental-mode))
  1156.                (get-buffer-create
  1157.                 (generate-new-buffer-name
  1158.                  (format
  1159.                   " efs-call-compress %s" filename))))))
  1160.        (save-excursion
  1161.          (set-buffer err-buff)
  1162.          (set (make-local-variable 'efs-call-compress-filename) filename)
  1163.          (set (make-local-variable 'efs-call-compress-newname) newname)
  1164.          (set (make-local-variable 'efs-call-compress-tmp1) tmp1)
  1165.          (set (make-local-variable 'efs-call-compress-tmp2) tmp2)
  1166.          (set (make-local-variable 'efs-call-compress-cont) cont)
  1167.          (set (make-local-variable 'efs-call-compress-nowait) nowait)
  1168.          (set (make-local-variable 'efs-call-compress-ok)
  1169.           ok-if-already-exists)
  1170.          (set (make-local-variable 'efs-call-compress-uncompress)
  1171.           uncompress)
  1172.          (set (make-local-variable 'efs-call-compress-abbr)
  1173.           (efs-relativize-filename filename))
  1174.          (if efs-verbose
  1175.          (efs-message
  1176.           (format "%s %s..."
  1177.               (if uncompress "Uncompressing" "Compressing")
  1178.               (symbol-value (make-local-variable
  1179.                      'efs-call-compress-abbr)))))
  1180.          (set-process-sentinel
  1181.           (start-process (format "efs-call-compress %s" filename)
  1182.                  err-buff shell-file-name
  1183.                  "-c" (format "%s %s < %s > %s"
  1184.                       program
  1185.                       ;; Hope -c makes the compress
  1186.                       ;; program write to std out.
  1187.                       "-c"
  1188.                       tmp1 tmp2))
  1189.           (function
  1190.            (lambda (proc str)
  1191.          (let ((buff (get-buffer (process-buffer proc))))
  1192.            (if buff
  1193.                (save-excursion
  1194.              (set-buffer buff)
  1195.              (if (/= (buffer-size) 0)
  1196.                  (if cont
  1197.                  (efs-call-cont
  1198.                   (symbol-value
  1199.                    (make-local-variable
  1200.                     'efs-call-compress-cont))
  1201.                   'failed
  1202.                   (concat
  1203.                    "failed to compress "
  1204.                    (symbol-value (make-local-variable
  1205.                           'efs-call-compress-filename))
  1206.                    ", "
  1207.                    (buffer-substring
  1208.                     (point-min)
  1209.                     (progn (goto-char (point-min))
  1210.                        (end-of-line) (point))))))
  1211.                (efs-del-tmp-name (symbol-value
  1212.                           (make-local-variable
  1213.                            'efs-call-compress-tmp1)))
  1214.                (let ((tmp2 (symbol-value
  1215.                     (make-local-variable
  1216.                      'efs-call-compress-tmp2)))
  1217.                  (newname (symbol-value
  1218.                        (make-local-variable
  1219.                         'efs-call-compress-newname)))
  1220.                  (filename (symbol-value
  1221.                         (make-local-variable
  1222.                          'efs-call-compress-filename)))
  1223.                  (cont (symbol-value
  1224.                     (make-local-variable
  1225.                      'efs-call-compress-cont)))
  1226.                  (nowait (symbol-value
  1227.                       (make-local-variable
  1228.                        'efs-call-compress-nowait)))
  1229.                  (ok (symbol-value
  1230.                       (make-local-variable
  1231.                        'efs-call-compress-ok)))
  1232.                  (uncompress
  1233.                   (symbol-value
  1234.                    (make-local-variable
  1235.                     'efs-call-compress-uncompress))))
  1236.                  (if efs-verbose
  1237.                  (efs-message
  1238.                   (format "%s %s...done"
  1239.                       (if uncompress
  1240.                           "Uncompressing"
  1241.                         "Compressing")
  1242.                       (symbol-value
  1243.                        (make-local-variable
  1244.                         'efs-call-compress-abbr)))))
  1245.                  (kill-buffer (current-buffer))
  1246.                  (efs-copy-file-internal
  1247.                   tmp2 nil newname (efs-ftp-path newname)
  1248.                   ok nil 1
  1249.                   (efs-cont (result line cont-lines) (cont
  1250.                                   tmp2
  1251.                                   filename)
  1252.                 (efs-del-tmp-name tmp2)
  1253.                 (or result
  1254.                     (let (efs-verbose)
  1255.                       (efs-delete-file filename)
  1256.                       (dired-remove-file filename)))
  1257.                 (if cont
  1258.                     (efs-call-cont cont result line
  1259.                            cont-lines)))
  1260.                   nowait (if uncompress nil 'image)))))
  1261.              (error "Strange error: %s" proc))))))))))
  1262.      nowait (if uncompress 'image nil))))
  1263.  
  1264. (defun efs-update-mode-string (perms modes)
  1265.   ;; For PERMS of the form `u+w', and MODES a unix 9-character mode string,
  1266.   ;; computes the new mode string.
  1267.   ;; Doesn't call efs-save-match-data. The calling function should.
  1268.   (or (string-match "^[augo]+\\([+-]\\)[rwxst]+$" perms)
  1269.       (error "efs-update-mode-string: invalid perms %s" perms))
  1270.   (let* ((who (substring perms 0 (match-beginning 1)))
  1271.      (add (= (aref perms (match-beginning 1)) ?+))
  1272.      (what (substring perms (match-end 1)))
  1273.      (newmodes (copy-sequence modes))
  1274.      (read (string-match "r" what))
  1275.      (write (string-match "w" what))
  1276.      (execute (string-match "x" what))
  1277.      (sticky (string-match "t" what))
  1278.      (suid (string-match "s" what)))
  1279.     (if (string-match "a" who)
  1280.     (if add
  1281.         (progn
  1282.           (if read
  1283.           (progn
  1284.             (aset newmodes 0 ?r)
  1285.             (aset newmodes 3 ?r)
  1286.             (aset newmodes 6 ?r)))
  1287.           (if write
  1288.           (progn
  1289.             (aset newmodes 1 ?w)
  1290.             (aset newmodes 4 ?w)
  1291.             (aset newmodes 7 ?w)))
  1292.           (if execute
  1293.           (let ((curr (aref newmodes 2)))
  1294.             (if (= curr ?-)
  1295.             (aset newmodes 2 ?x)
  1296.               (if (= curr ?S)
  1297.               (aset newmodes 2 ?s)))
  1298.             (setq curr (aref newmodes 5))
  1299.             (if (= curr ?-)
  1300.             (aset newmodes 5 ?x)
  1301.               (if (= curr ?S)
  1302.               (aset newmodes 5 ?s)))
  1303.             (setq curr (aref newmodes 8))
  1304.             (if (= curr ?-)
  1305.             (aset newmodes 8 ?x)
  1306.               (if (= curr ?T)
  1307.               (aset newmodes 8 ?t)))))
  1308.           (if suid
  1309.           (let ((curr (aref newmodes 2)))
  1310.             (if (= curr ?-)
  1311.             (aset newmodes 2 ?S)
  1312.               (if (= curr ?x)
  1313.               (aset newmodes 2 ?s)))
  1314.             (setq curr (aref newmodes 5))
  1315.             (if (= curr ?-)
  1316.             (aset newmodes 5 ?S)
  1317.               (if (= curr ?x)
  1318.               (aset newmodes 5 ?s)))))
  1319.           (if sticky
  1320.           (let ((curr (aref newmodes 8)))
  1321.             (if (= curr ?-)
  1322.             (aset newmodes 8 ?T)
  1323.               (if (= curr ?x)
  1324.               (aset newmodes 8 ?t))))))
  1325.       (if read
  1326.           (progn
  1327.         (aset newmodes 0 ?-)
  1328.         (aset newmodes 3 ?-)
  1329.         (aset newmodes 6 ?-)))
  1330.       (if write
  1331.           (progn
  1332.         (aset newmodes 1 ?-)
  1333.         (aset newmodes 4 ?-)
  1334.         (aset newmodes 7 ?-)))
  1335.       (if execute
  1336.           (let ((curr (aref newmodes 2)))
  1337.         (if (= curr ?x)
  1338.             (aset newmodes 2 ?-)
  1339.           (if (= curr ?s)
  1340.               (aset newmodes 2 ?S)))
  1341.         (setq curr (aref newmodes 5))
  1342.         (if (= curr ?x)
  1343.             (aset newmodes 5 ?-)
  1344.           (if (= curr ?s)
  1345.               (aset newmodes 5 ?S)))
  1346.             (setq curr (aref newmodes 8))
  1347.             (if (= curr ?x)
  1348.             (aset newmodes 8 ?-)
  1349.               (if (= curr ?t)
  1350.               (aset newmodes 8 ?T)))))
  1351.       (if suid
  1352.           (let ((curr (aref newmodes 2)))
  1353.         (if (= curr ?s)
  1354.             (aset newmodes 2 ?x)
  1355.           (if (= curr ?S)
  1356.               (aset newmodes 2 ?-)))
  1357.         (setq curr (aref newmodes 5))
  1358.         (if (= curr ?s)
  1359.             (aset newmodes 5 ?x)
  1360.           (if (= curr ?S)
  1361.               (aset newmodes 5 ?-)))))
  1362.       (if sticky
  1363.           (let ((curr (aref newmodes 8)))
  1364.         (if (= curr ?t)
  1365.             (aset newmodes 8 ?x)
  1366.           (if (= curr ?T)
  1367.               (aset newmodes 8 ?-))))))
  1368.       (if (string-match "u" who)
  1369.       (if add
  1370.           (progn
  1371.         (if read
  1372.             (aset newmodes 0 ?r))
  1373.         (if write
  1374.             (aset newmodes 1 ?w))
  1375.         (if execute
  1376.             (let ((curr (aref newmodes 2)))
  1377.               (if (= curr ?-)
  1378.               (aset newmodes 2 ?x)
  1379.             (if (= curr ?S)
  1380.                 (aset newmodes 2 ?s)))))
  1381.         (if suid
  1382.             (let ((curr (aref newmodes 2)))
  1383.               (if (= curr ?-)
  1384.               (aset newmodes 2 ?S)
  1385.             (if (= curr ?x)
  1386.                 (aset newmodes 2 ?s))))))
  1387.         (if read
  1388.         (aset newmodes 0 ?-))
  1389.         (if write
  1390.         (aset newmodes 1 ?-))
  1391.         (if execute
  1392.         (let ((curr (aref newmodes 2)))
  1393.           (if (= curr ?x)
  1394.               (aset newmodes 2 ?-)
  1395.             (if (= curr ?s)
  1396.             (aset newmodes 2 ?S)))))
  1397.         (if suid
  1398.         (let ((curr (aref newmodes 2)))
  1399.           (if (= curr ?s)
  1400.               (aset newmodes 2 ?x)
  1401.             (if (= curr ?S)
  1402.             (aset newmodes 2 ?-)))))))
  1403.       (if (string-match "g" who)
  1404.       (if add
  1405.           (progn
  1406.         (if read
  1407.             (aset newmodes 3 ?r))
  1408.         (if write
  1409.             (aset newmodes 4 ?w))
  1410.         (if execute
  1411.             (let ((curr (aref newmodes 5)))
  1412.               (if (= curr ?-)
  1413.               (aset newmodes 5 ?x)
  1414.             (if (= curr ?S)
  1415.                 (aset newmodes 5 ?s)))))
  1416.         (if suid
  1417.             (let ((curr (aref newmodes 5)))
  1418.               (if (= curr ?-)
  1419.               (aset newmodes 5 ?S)
  1420.             (if (= curr ?x)
  1421.                 (aset newmodes 5 ?s))))))
  1422.         (if read
  1423.         (aset newmodes 3 ?-))
  1424.         (if write
  1425.         (aset newmodes 4 ?-))
  1426.         (if execute
  1427.         (let ((curr (aref newmodes 5)))
  1428.           (if (= curr ?x)
  1429.               (aset newmodes 5 ?-)
  1430.             (if (= curr ?s)
  1431.             (aset newmodes 5 ?S)))))
  1432.         (if suid
  1433.         (let ((curr (aref newmodes 5)))
  1434.           (if (= curr ?s)
  1435.               (aset newmodes 5 ?x)
  1436.             (if (= curr ?S)
  1437.             (aset newmodes 5 ?-)))))))
  1438.       (if (string-match "o" who)
  1439.       (if add
  1440.           (progn
  1441.         (if read
  1442.             (aset newmodes 6 ?r))
  1443.         (if write
  1444.             (aset newmodes 7 ?w))
  1445.         (if execute
  1446.             (let ((curr (aref newmodes 8)))
  1447.               (if (= curr ?-)
  1448.               (aset newmodes 8 ?x)
  1449.             (if (= curr ?T)
  1450.                 (aset newmodes 8 ?t)))))
  1451.         (if sticky
  1452.             (let ((curr (aref newmodes 8)))
  1453.               (if (= curr ?-)
  1454.               (aset newmodes 8 ?T)
  1455.             (if (= curr ?x)
  1456.                 (aset newmodes 5 ?t))))))
  1457.         (if read
  1458.         (aset newmodes 6 ?-))
  1459.         (if write
  1460.         (aset newmodes 7 ?-))
  1461.         (if execute
  1462.         (let ((curr (aref newmodes 8)))
  1463.           (if (= curr ?x)
  1464.               (aset newmodes 8 ?-)
  1465.             (if (= curr ?t)
  1466.             (aset newmodes 8 ?T)))))
  1467.         (if suid
  1468.         (let ((curr (aref newmodes 8)))
  1469.           (if (= curr ?t)
  1470.               (aset newmodes 8 ?x)
  1471.             (if (= curr ?T)
  1472.             (aset newmodes 8 ?-))))))))
  1473.     newmodes))
  1474.  
  1475. (defun efs-compute-chmod-arg (perms file)
  1476.   ;; Computes the octal number, represented as a string, required to 
  1477.   ;; modify the permissions PERMS of FILE.
  1478.   (efs-save-match-data
  1479.     (cond
  1480.      ((string-match "^[0-7][0-7]?[0-7]?[0-7]?$" perms)
  1481.       perms)
  1482.      ((string-match "^[augo]+[-+][rwxst]+$" perms)
  1483.       (let ((curr-mode (nth 3 (efs-get-file-entry file))))
  1484.     (or (and curr-mode
  1485.          (stringp curr-mode)
  1486.          (= (length curr-mode) 10))
  1487.         (progn
  1488.           ;; Current buffer is process error buffer
  1489.           (insert "Require an octal integer to modify modes for "
  1490.               file ".\n")
  1491.           (error "Require an octal integer to modify modes for %s." file)))
  1492.     (format "%o"
  1493.         (efs-parse-mode-string
  1494.          (efs-update-mode-string perms
  1495.                           (substring curr-mode 1))))))
  1496.      (t
  1497.       (insert "Don't know how to set modes " perms " for " file ".\n")
  1498.       (error "Don't know how to set modes %s" perms)))))
  1499.  
  1500. (defun efs-call-chmod (args)
  1501.   ;; Sends an FTP CHMOD command.
  1502.   (if (< (length args) 2)
  1503.       (error "efs-call-chmod: missing mode and/or filename: %s" args))
  1504.   (let ((mode (car args))
  1505.     bombed)
  1506.     (mapcar
  1507.      (function
  1508.       (lambda (file)
  1509.     (setq file (expand-file-name file))
  1510.     (let ((parsed (efs-ftp-path file)))
  1511.       (if parsed
  1512.           (condition-case nil
  1513.           (let* ((mode (efs-compute-chmod-arg mode file))
  1514.              (host (nth 0 parsed))
  1515.              (user (nth 1 parsed))
  1516.              (path (efs-quote-string
  1517.                 (efs-host-type host user) (nth 2 parsed)))
  1518.              (abbr (efs-relativize-filename file))
  1519.              (result (efs-send-cmd host user
  1520.                            (list 'quote 'site 'chmod
  1521.                              mode path)
  1522.                            (format "doing chmod %s"
  1523.                                abbr))))
  1524.  
  1525.             (if (car result)
  1526.             (efs-dired-shell-call-process
  1527.               (concat "chmod " mode " " (file-name-nondirectory file))
  1528.               (file-name-directory file)))
  1529.  
  1530.             (efs-del-from-ls-cache file t))
  1531.         (error (setq bombed t)))))))
  1532.      (cdr args))
  1533.     (if bombed 1 0)))                      ; return code
  1534.  
  1535. (defun efs-call-lpr (file command-format)
  1536.   "Print remote file FILE. SWITCHES are passed to the print program."
  1537.   ;; Works asynch.
  1538.   (let* ((file (expand-file-name file))
  1539.      (parsed (efs-ftp-path file))
  1540.      (abbr (efs-relativize-filename file))
  1541.      (temp (car (efs-make-tmp-name nil (car parsed)))))
  1542.     (efs-copy-file-internal
  1543.      file parsed temp nil t nil 2
  1544.      (efs-cont (result line cont-lines) (command-format file abbr temp)
  1545.        (if result
  1546.        (signal 'ftp-error (list "Opening input file"
  1547.                     (format "FTP Error: \"%s\" " line)
  1548.                     file))
  1549.      (message "Spooling %s..." abbr)
  1550.      (set-process-sentinel
  1551.       (start-process (format "*print %s /// %s*" abbr temp)
  1552.              (generate-new-buffer-name " *print temp*")
  1553.              "sh" "-c" (format command-format temp))
  1554.       (function
  1555.        (lambda (proc status)
  1556.          (let ((buff (process-buffer proc))
  1557.            (name (process-name proc)))
  1558.            (if (and buff (get-buffer buff))
  1559.            (unwind-protect
  1560.                (save-excursion
  1561.              (set-buffer buff)
  1562.              (if (> (buffer-size) 0)
  1563.                  (let ((log-buff (get-buffer-create
  1564.                           "*Shell Command Output*")))
  1565.                    (set-buffer log-buff)
  1566.                    (goto-char (point-max))
  1567.                    (or (bobp)
  1568.                    (insert "\n"))
  1569.                    (insert-buffer-substring buff)
  1570.                    (goto-char (point-max))
  1571.                    (display-buffer log-buff))))
  1572.              (condition-case nil (kill-buffer buff) (error nil))
  1573.              (efs-save-match-data
  1574.                (if (string-match "^\\*print \\(.*\\) /// \\(.*\\)\\*$"
  1575.                      name)
  1576.                (let ((abbr (substring name (match-beginning 1)
  1577.                           (match-end 1)))
  1578.                  (temp (substring name (match-beginning 2)
  1579.                           (match-end 2))))
  1580.                  (or (= (match-beginning 2) (match-end 2))
  1581.                  (efs-del-tmp-name temp))
  1582.                  (message "Spooling %s...done" abbr))))))))))))
  1583.      t)))
  1584.  
  1585. ;;;; --------------------------------------------------------------
  1586. ;;;; Attaching onto dired.
  1587. ;;;; --------------------------------------------------------------
  1588.  
  1589. ;;; Look out for MULE
  1590. (if (or (boundp 'MULE) (featurep 'mule)) (load "efs-dired-mule"))
  1591.  
  1592. ;;; Magic file name hooks for dired.
  1593.  
  1594. (put 'dired-print-file 'efs 'efs-dired-print-file)
  1595. (put 'dired-make-compressed-filename 'efs 'efs-dired-make-compressed-filename)
  1596. (put 'dired-compress-file 'efs 'efs-dired-compress-file)
  1597. (put 'dired-recursive-delete-directory 'efs
  1598.      'efs-dired-recursive-delete-directory)
  1599. (put 'dired-uncache 'efs 'efs-dired-uncache)
  1600. (put 'dired-shell-call-process 'efs 'efs-dired-shell-call-process)
  1601. (put 'dired-shell-unhandle-file-name 'efs 'efs-dired-shell-unhandle-file-name)
  1602. (put 'dired-file-modtime 'efs 'efs-dired-file-modtime)
  1603. (put 'dired-set-file-modtime 'efs 'efs-dired-set-file-modtime)
  1604.  
  1605. ;;; Overwriting functions
  1606.  
  1607. (efs-overwrite-fn "efs" 'dired-call-process)
  1608. (efs-overwrite-fn "efs" 'dired-insert-headerline)
  1609. (efs-overwrite-fn "efs" 'dired-manual-move-to-filename)
  1610. (efs-overwrite-fn "efs" 'dired-manual-move-to-end-of-filename)
  1611. (efs-overwrite-fn "efs" 'dired-make-filename-string)
  1612. (efs-overwrite-fn "efs" 'dired-flag-backup-files)
  1613. (efs-overwrite-fn "efs" 'dired-create-files)
  1614. (efs-overwrite-fn "efs" 'dired-find-file)
  1615. (efs-overwrite-fn "efs" 'dired-find-file-other-window)
  1616. (efs-overwrite-fn "efs" 'dired-find-file-other-frame)
  1617. (efs-overwrite-fn "efs" 'dired-collect-file-versions)
  1618. (efs-overwrite-fn "efs" 'dired-file-name-lessp)
  1619.  
  1620. ;;; Hooks
  1621.  
  1622. (add-hook 'dired-before-readin-hook 'efs-dired-before-readin)
  1623.  
  1624. ;;; Handle dired-grep.el too.
  1625.  
  1626. (if (featurep 'dired-grep)
  1627.     (efs-overwrite-fn "efs" 'dired-grep-delete-local-temp-file
  1628.               'efs-diff/grep-del-temp-file)
  1629.   (add-hook 'dired-grep-load-hook
  1630.         (function
  1631.          (lambda ()
  1632.            (efs-overwrite-fn "efs" 'dired-grep-delete-local-temp-file
  1633.                  'efs-diff/grep-del-temp-file)))))
  1634.  
  1635. ;;; end of efs-dired.el
  1636.